Cream of the Crop 22/Cream of the Crop 22.iso/program/ctlib100.zip/INSTALL.LZH/TABLE2.PAS

Pascal/Delphi Source File | 1996-10-12 | 6KB | 213 lines

{**************************************************************************}
{*  BitSoft Development, L.L.C.                                           *}
{*  Copyright (C) 1995, 1996 BitSoft Development, L.L.C.                  *}
{*  All rights reserved.                                                  *}
{*  Containers Library demo                                               *}
{**************************************************************************}

program Table2;

{$X+}

{ This program demonstrates how to create a field structure, use it to
initialize a TObjectTable, insert an object, and return results.  It contains
all examples for object tables described in the documentation chapter on
tables. }

uses
  Objects, Crt, BsdTest, ctTypes, ctFields, ctTables;

const
  TempFile = 'test.dat';
  BufferSize = 2048;
  OpenedFromDisk: Boolean = False;

var
  FieldStructure: PFieldStructure;
  Table: PTable;

type
  PAddress = ^TAddress;
  TAddress = Object(TObject)
    Line1: PString;
    Line2: PString;
    City: PString;
    State: PString;
    constructor Init (ALine1, ALine2, ACity, AState: string);
    constructor Load (var S: TStream);
    destructor Done; virtual;
    procedure Store (var S: TStream); virtual;
  end;  { of TAddress }

constructor TAddress.Init (ALine1, ALine2, ACity, AState: string);
begin
  if not TObject.Init then
    Fail;
  Line1 := NewStr(ALine1);
  Line2 := NewStr(ALine2);
  City := NewStr(ACity);
  State := NewStr(AState);
end;

constructor TAddress.Load (var S: TStream);
begin
  if not TObject.Init then
    Fail;
  Line1 := S.ReadStr;
  Line2 := S.ReadStr;
  City := S.ReadStr;
  State := S.ReadStr;
end;

destructor TAddress.Done;
begin
  DisposeStr(Line1);
  DisposeStr(Line2);
  DisposeStr(City);
  DisposeStr(State);
  TObject.Done;
end;

procedure TAddress.Store (var S: TStream);
begin
  S.WriteStr(Line1);
  S.WriteStr(Line2);
  S.WriteStr(City);
  S.WriteStr(State);
end;

const
  RAddress: TStreamRec = (
    ObjType: 2099;
    VmtLink: Ofs(TypeOf(TAddress)^);
    Load: @TAddress.Load;
    Store: @TAddress.Store);


function AddressFieldStructure: PFieldStructure;
var
  FieldStructure: PFieldStructure;
  Field: PField;
  Name: TFieldName;
  i: Integer;
begin
  FieldStructure := New(PFieldStructure,Init(4,1));
  if (FieldStructure <> nil) then
  begin
    for i := 1 to 4 do
    begin
      case i of
        1: Name := 'Line1';
        2: Name := 'Line2';
        3: Name := 'City';
        4: Name := 'State';
      end;
      Field := New(PField, Init(Name, ftPString, 50, 0));
      if (Field <> nil) then
        FieldStructure^.Insert(Field)
      else Error('Out of memory.');
    end;
  end;
  AddressFieldStructure := FieldStructure;
end;


procedure InsertAddresses;
var
  Address: PAddress;
begin
  Address := New(PAddress,Init('Mickey Mouse', 'Disney World',
                               'Orlando', 'Florida'));
  if Address = nil then
    Error('Out of memory.  Could not create address record.');
  Table^.Insert(Address);
end;

procedure ShowAddresses;
var
  RecNo: LongInt;
  procedure ShowAddress (Address: PAddress); far;
  begin
    WriteLn('Record Number = ',RecNo);
    with Address^ do
    begin
      WriteLn('   ',Line1^);
      WriteLn('   ',Line2^);
      WriteLn('   ',City^,', ',State^);
    end;
    WriteLn;
    Inc(RecNo);
  end;
begin
  with Table^ do
  begin
    if not OpenedFromDisk then
    begin
      WriteLn('Table''s Field Structure');
      Structure^.ShowInfo(OutPut);
      WriteLn;
    end;
    RecNo := 0;
    ForEach(@ShowAddress);
  end;
end;

var
  F: File;  { just used to delete table so we don't litter your disk }
  Size: LongInt;
  Stream: PStream;
begin
  ClrScr;
    { Don't forget to register all the objects! }
  RegisterType(RField);
  RegisterType(RFieldStructure);
  RegisterType(RAddress);
  Size := MemAvail;
  FieldStructure := AddressFieldStructure;
  if (FieldStructure = nil) then
    Error('Error creating field structure.');
  Stream := New(PBufStream, Init(TempFile, stCreate, 2048));
  Table := New(PObjectTable, Init(FieldStructure, Stream));
  if (Table = nil) then
  begin
      { Caution!!!! Don't dispose of the table structure if table
        initialization was successful.  It is used and will be disposed of by
        the table. }
    Dispose(FieldStructure, Done);
    Error('Error constructing table.');
  end;
  WriteLn('Table created successfully.');
  InsertAddresses;
  WriteLn('Addresses inserted successfully.');
  WriteLn;
  ShowAddresses;
  WriteLn('Closing table.');
  Dispose(Table, Done);
    { Tables don't dispose of the stream on which they are stored so that the
      stream can be used for other purposes within the application.  You must
      explicitly dispose of the table's stream when you are finished using it
      to prevent a memory leak and ensure all data is flushed from the
      stream's buffers. }
  Dispose(Stream, Done);
  WriteLn('Reopening table.');
  Stream := New(PBufStream, Init(TempFile, stOpen, BufferSize));
  Table := New(PObjectTable, Open(Stream));
  if (Table = nil) then
    Error('Error opening table.')
  else begin
    WriteLn('Opened table successfully.');
    OpenedFromDisk := True;
  end;
  WriteLn;
  ShowAddresses;
  Dispose(Table, Done);
  Dispose(Stream, Done);
    { remove the table }
  Assign(F, TempFile);
  {$I-}
  Erase(F);
  {$I+}
  if (Size <> MemAvail) then
    WriteLn('Memory leak.');
  ReadLn;
end.